home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #4 / Amiga Plus CD - 2000 - No. 4.iso / Tools / Up2Date / InstallerNG / examples / math.installer < prev    next >
Encoding:
Text File  |  1999-11-02  |  3.7 KB  |  151 lines
  1.  
  2. (user expert)
  3. (set @proceed-button "Interesting... go on!"
  4.      @abort-button "Urgs"
  5. )
  6.  
  7. (message "\n\n\nWelcome to some recursive math...\n\n\n"
  8.          "Please have a look at the source to see how to\n"
  9.          "program recursive functions and how to use\n"
  10.          "local environments of procedures!"
  11.          "\n\nNote: send CTRL-F to the installer process,\n"
  12.          "if you want to stop interpretation"
  13. )
  14.  
  15. ; --------------------------------------------------------------------------------
  16. ; define a recursive procedure which calculates the faculty of
  17. ; a given argument. use the LET function to create a local environment
  18. ; note: for arguments greater than 12 there will be an overflow,
  19. ;       but this does not result in any runtime error
  20.  
  21. (procedure faculty a
  22.  
  23.   (set fac_number (+ 1 fac_number))
  24.  
  25.   (let (set f a)
  26.  
  27.        (if (= f 1)
  28.            1
  29.            (* f (faculty (- f 1)))
  30.        )
  31.   )
  32. )
  33.  
  34. ; --------------------------------------------------------------------------------
  35. ; the function "Ackerman" is a extremly recursive function, which only
  36. ; runs with local variables. thus here you must use the LET function
  37. ;
  38. ; the definition of the ackerman function is:
  39. ; a(0,y) = y+1
  40. ; a(x,0) = a(x-1,1)
  41. ; a(x,y) = a(x-1,a(x,y-1))
  42.  
  43. (procedure ackerman a b
  44.  
  45.   (set ack_number (+ 1 ack_number))
  46.  
  47.   (let (set x a y b)
  48.  
  49.        (if (= x 0)
  50.            (+ y 1)
  51.            (if (= y 0)
  52.                (ackerman (- x 1) 1)
  53.                (ackerman (- x 1) (ackerman x (- y 1)))
  54.            )
  55.        )
  56.   )
  57. )
  58.  
  59. ; --------------------------------------------------------------------------------
  60. ; this is the well known function "fibonacci"; it is formally defined
  61. ; as follows:
  62. ;
  63. ; fib(0) = 1
  64. ; fib(1) = 1
  65. ; fib(n) = fib(n-1) + fib(n-2)
  66.  
  67. (procedure fibonacci f
  68.  
  69.   (set fib_number (+ 1 fib_number))
  70.  
  71.   (let (set n f)
  72.  
  73.        (if (= n 0) 1
  74.                    (if (= n 1) 1
  75.                                (+ (fibonacci (- n 1)) (fibonacci (- n 2)))
  76.                    )
  77.        )
  78.   )
  79. )
  80.  
  81. ; --------------------------------------------------------------------------------
  82. ; ask for the values
  83.  
  84. (set fac 3
  85.      fib 5
  86. )
  87.  
  88. (swing
  89.  
  90.   (set fac (asknumber (prompt "Faculty of what ?")
  91.                       (help "enter the number you want to know the faculty of")
  92.                       (default fac)
  93.                       (range 1 12)
  94.            )
  95.   )
  96.  
  97.   (set fib (asknumber (prompt "Fibonacci of what ?")
  98.                       (help "enter the number you want to know the fibonacci number of")
  99.                       (default fib)
  100.                       (range 1 25)
  101.            )
  102.   )
  103.  
  104.   (message "Done? So lets start the evaluation...")
  105. )
  106.  
  107. ; --------------------------------------------------------------------------------
  108. ; calculate and print the faculty
  109.  
  110. (working (cat "Please be patient... this really could take a while\n"
  111.               "(depends on the given values....)\n\n"
  112.               "Send CTRL-F to break"
  113.          )
  114. )
  115.  
  116. (set start_time (database "time"))
  117. (set fac_number 0
  118.      fib_number 0
  119.      ack_number 0
  120. )
  121.  
  122. (complete 0)
  123. (set result_fac (faculty fac))
  124.  
  125. (complete 33)
  126. (set result_fib (fibonacci fib))
  127.  
  128. (complete 66)
  129. (set result_ack (ackerman 1 2))
  130.  
  131. (set end_time (database "time"))
  132.  
  133. (complete 100)
  134. (message "Faculty of " fac " = " result_fac "\n"
  135.          "Fibonacci of " fib " = " result_fib "\n"
  136.          "Ackerman(1,2) = " result_ack "\n\n"
  137.          "Took from " start_time " until " end_time "\n\n"
  138.          "\n----------\n"
  139.          "Function call statistics: \n"
  140.          "Faculty " fac_number " times\n"
  141.          "Fibonacci " fib_number " times\n"
  142.          "Ackerman " ack_number " times"
  143. )
  144.  
  145. ; --------------------------------------------------------------------------------
  146. ; avoid stupid welcome...   :)
  147.  
  148. (exit (quiet))
  149. (welcome)
  150.  
  151.